home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / prim / modeline.el.z / modeline.el
Encoding:
Text File  |  1998-05-21  |  22.1 KB  |  585 lines
  1. ;;; modeline.el --- modeline hackery.
  2.  
  3. ;; Copyright (C) 1988, 1992-1994, 1997 Free Software Foundation, Inc.
  4. ;; Copyright (C) 1995, 1996 Ben Wing.
  5.  
  6. ;; This file is part of XEmacs.
  7.  
  8. ;; XEmacs is free software; you can redistribute it and/or modify it
  9. ;; under the terms of the GNU General Public License as published by
  10. ;; the Free Software Foundation; either version 2, or (at your option)
  11. ;; any later version.
  12.  
  13. ;; XEmacs is distributed in the hope that it will be useful, but
  14. ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  15. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  16. ;; General Public License for more details.
  17.  
  18. ;; You should have received a copy of the GNU General Public License
  19. ;; along with XEmacs; see the file COPYING.  If not, write to the 
  20. ;; Free Software Foundation, 59 Temple Place - Suite 330,
  21. ;; Boston, MA 02111-1307, USA.
  22.  
  23. ;;; Synched up with: Not in FSF.
  24.  
  25. ;;; Commentary:
  26.  
  27. ;;; Code:
  28.  
  29. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  30. ;;;                     General mouse modeline stuff                    ;;;
  31. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  32.  
  33. (defgroup modeline nil
  34.   "Modeline customizations"
  35.   :group 'environment)
  36.  
  37. (defcustom drag-modeline-event-lag 150
  38.   "*The pause (in msecs) between drag modeline events before redisplaying.
  39. If this value is too small, dragging will be choppy because redisplay cannot
  40. keep up. If it is too large, dragging will be choppy because of the explicit
  41. redisplay delay specified."
  42.   :type 'integer
  43.   :group 'modeline)
  44.  
  45. (defcustom modeline-click-swaps-buffers nil
  46.   "*If non-nil, clicking on the modeline changes the current buffer.
  47. Click on the left half of the modeline cycles forward through the
  48. buffer list and clicking on the right half cycles backward."
  49.   :type 'boolean
  50.   :group 'modeline)
  51.  
  52. (defun mouse-drag-modeline (event)
  53.   "Resize a window by dragging its modeline.
  54. This command should be bound to a button-press event in modeline-map.
  55. Holding down a mouse button and moving the mouse up and down will
  56. make the clicked-on window taller or shorter."
  57.   (interactive "e")
  58.   (or (button-press-event-p event)
  59.       (error "%s must be invoked by a mouse-press" this-command))
  60.   (or (event-over-modeline-p event)
  61.       (error "not over a modeline"))
  62.   (let ((done nil)
  63.     (depress-line (event-y event))
  64.     (start-event-frame (event-frame event))
  65.     (start-event-window (event-window event))
  66.     (start-nwindows (count-windows t))
  67.     (last-timestamp 0)
  68.     default-line-height
  69.     modeline-height
  70.     should-enlarge-minibuffer
  71.     event min-height minibuffer y top bot edges wconfig growth)
  72.     (setq minibuffer (minibuffer-window start-event-frame)
  73.       default-line-height (face-height 'default start-event-window)
  74.       min-height (+ (* window-min-height default-line-height)
  75.             ;; Don't let the window shrink by a
  76.             ;; non-multiple of the default line
  77.             ;; height.  (enlarge-window -1) will do
  78.             ;; this if the difference between the
  79.             ;; current window height and the minimum
  80.             ;; window height is less than the height
  81.             ;; of the default font.  These extra
  82.             ;; lost pixels of height don't come back
  83.             ;; if you grow the window again.  This
  84.             ;; can make it impossible to drag back
  85.             ;; to the exact original size, which is
  86.             ;; disconcerting.
  87.             (% (window-pixel-height start-event-window)
  88.                default-line-height))
  89.       modeline-height
  90.         (if (specifier-instance has-modeline-p start-event-window)
  91.         (+ (face-height 'modeline start-event-window)
  92.            (* 2 (specifier-instance modeline-shadow-thickness
  93.                         start-event-window)))
  94.           (* 2 (specifier-instance modeline-shadow-thickness
  95.                        start-event-window))))
  96.     (if (not (eq (window-frame minibuffer) start-event-frame))
  97.     (setq minibuffer nil))
  98.     (if (and (null minibuffer) (one-window-p t))
  99.     (error "Attempt to resize sole window"))
  100.     ;; if this is the bottommost ordinary window, then to
  101.     ;; move its modeline the minibuffer must be enlarged.
  102.     (setq should-enlarge-minibuffer
  103.       (and minibuffer (window-lowest-p start-event-window)))
  104.     ;; loop reading events
  105.     (while (not done)
  106.       (setq event (next-event event))
  107.       ;; requeue event and quit if this is a misc-user, eval or
  108.       ;;   keypress event.
  109.       ;; quit if this is a button press or release event, or if the event
  110.       ;;   occurred in some other frame.
  111.       ;; drag if this is a mouse motion event and the time
  112.       ;;   between this event and the last event is greater than
  113.       ;;   drag-modeline-event-lag.
  114.       ;; do nothing if this is any other kind of event.
  115.       (cond ((or (misc-user-event-p event)
  116.          (key-press-event-p event))
  117.          (setq unread-command-events (nconc unread-command-events
  118.                         (list event))
  119.            done t))
  120.         ((button-release-event-p event)
  121.          (setq done t)
  122.          (if modeline-click-swaps-buffers
  123.          (mouse-release-modeline event depress-line)))
  124.         ((button-event-p event)
  125.          (setq done t))
  126.         ((not (motion-event-p event))
  127.          (dispatch-event event))
  128.         ((not (eq start-event-frame (event-frame event)))
  129.          (setq done t))
  130.         ((< (abs (- (event-timestamp event) last-timestamp))
  131.         drag-modeline-event-lag)
  132.          nil)
  133.         (t
  134.          (setq last-timestamp (event-timestamp event)
  135.            y (event-y-pixel event)
  136.            edges (window-pixel-edges start-event-window)
  137.            top (nth 1 edges)
  138.            bot (nth 3 edges))
  139.          ;; scale back a move that would make the
  140.          ;; window too short.
  141.          (cond ((< (- y top (- modeline-height)) min-height)
  142.             (setq y (+ top min-height (- modeline-height)))))
  143.          ;; compute size change needed
  144.          (setq growth (- y bot (/ (- modeline-height) 2))
  145.            wconfig (current-window-configuration))
  146.          ;; grow/shrink minibuffer?
  147.          (if should-enlarge-minibuffer
  148.          (progn
  149.            ;; yes.  scale back shrinkage if it
  150.            ;; would make the minibuffer less than 1
  151.            ;; line tall.
  152.            ;;
  153.            ;; also flip the sign of the computed growth,
  154.            ;; since if we want to grow the window with the
  155.            ;; modeline we need to shrink the minibuffer
  156.            ;; and vice versa.
  157.            (if (and (> growth 0)
  158.                 (< (- (window-pixel-height minibuffer)
  159.                   growth)
  160.                    default-line-height))
  161.                (setq growth
  162.                  (- (window-pixel-height minibuffer)
  163.                 default-line-height)))
  164.              (setq growth (- growth))))
  165.          ;; window grow and shrink by lines not pixels, so
  166.          ;; divide the pixel height by the height of the
  167.          ;; default face.
  168.          (setq growth (/ growth default-line-height))
  169.          ;; grow/shrink the window
  170.          (enlarge-window growth nil (if should-enlarge-minibuffer
  171.                         minibuffer
  172.                       start-event-window))
  173.          ;; if this window's growth caused another
  174.          ;; window to be deleted because it was too
  175.          ;; short, rescind the change.
  176.          ;;
  177.          ;; if size change caused space to be stolen
  178.          ;; from a window above this one, rescind the
  179.          ;; change, but only if we didn't grow/shrink
  180.          ;; the minibuffer.  minibuffer size changes
  181.          ;; can cause all windows to shrink... no way
  182.          ;; around it.
  183.          (if (or (/= start-nwindows (count-windows t))
  184.              (and (not should-enlarge-minibuffer)
  185.               (/= top (nth 1 (window-pixel-edges
  186.                       start-event-window)))))
  187.          (set-window-configuration wconfig)))))))
  188.  
  189. ;; from Bob Weiner (bob_weiner@pts.mot.com)
  190. (defun mouse-release-modeline (event line-num)
  191.   "Handle modeline click EVENT on LINE-NUM by switching buffers.
  192. If click on left half of a frame's modeline, bury current buffer.
  193. If click on right half of a frame's modeline, raise bottommost buffer.
  194. Args are: EVENT, the mouse release event, and LINE-NUM, the line number
  195. within the frame at which the mouse was first depressed."
  196.   (if (= line-num (event-y event))
  197.       ;; Button press and release are at same line, treat this as
  198.       ;; a click and switch buffers.
  199.     (if (< (event-x event) (/ (window-width (event-window event)) 2))
  200.         ;; On left half of modeline, bury current buffer,
  201.         ;; displaying second buffer on list.
  202.         (mouse-bury-buffer event)
  203.       ;; On right half of modeline, raise and display bottommost
  204.       ;; buffer in buffer list.
  205.       (mouse-unbury-buffer event))))
  206.  
  207. (defconst modeline-menu
  208.   '("Window Commands"
  209.     ["Delete Window Above"     delete-window            t]
  210.     ["Delete Other Windows"     delete-other-windows        t]
  211.     ["Split Window Above"     split-window-vertically    t]
  212.     ["Split Window Horizontally" split-window-horizontally    t]
  213.     ["Balance Windows"         balance-windows        t]
  214.     ))
  215.  
  216. (defun modeline-menu (event)
  217.   (interactive "e")
  218.   (popup-menu-and-execute-in-window
  219.    (cons (format "Window Commands for %S:"
  220.          (buffer-name (event-buffer event)))
  221.      (cdr modeline-menu))
  222.    event))
  223.  
  224. (defvar modeline-map (make-sparse-keymap 'modeline-map)
  225.   "Keymap consulted for mouse-clicks on the modeline of a window.
  226. This variable may be buffer-local; its value will be looked up in
  227. the buffer of the window whose modeline was clicked upon.")
  228.  
  229. (define-key modeline-map 'button1 'mouse-drag-modeline)
  230. ;; button2 selects the window without setting point
  231. (define-key modeline-map 'button2 (lambda () (interactive "@")))
  232. (define-key modeline-map 'button3 'modeline-menu)
  233.  
  234. (make-face 'modeline-mousable "Face for mousable portions of the modeline.")
  235. (set-face-parent 'modeline-mousable 'modeline)
  236. (when (featurep 'x)
  237.   (set-face-foreground 'modeline-mousable "firebrick" 'global '(color x))
  238.   (set-face-font 'modeline-mousable [bold] nil '(mono x))
  239.   (set-face-font 'modeline-mousable [bold] nil '(grayscale x)))
  240.  
  241. (defmacro make-modeline-command-wrapper (command)
  242.   `#'(lambda (event)
  243.        (interactive "e")
  244.        (save-selected-window
  245.      (select-window (event-window event))
  246.      (call-interactively ',(eval command)))))
  247.  
  248. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  249. ;;;                            Minor modes                              ;;;
  250. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  251.  
  252. (defvar minor-mode-alist nil
  253.   "Alist saying how to show minor modes in the modeline.
  254. Each element looks like (VARIABLE STRING);
  255. STRING is included in the modeline iff VARIABLE's value is non-nil.
  256.  
  257. Actually, STRING need not be a string; any possible modeline element
  258. is okay.  See `modeline-format'.")
  259.  
  260. ;; Used by C code (lookup-key and friends) but defined here.
  261. (defvar minor-mode-map-alist nil
  262.   "Alist of keymaps to use for minor modes.
  263. Each element looks like (VARIABLE . KEYMAP); KEYMAP is used to read
  264. key sequences and look up bindings iff VARIABLE's value is non-nil.
  265. If two active keymaps bind the same key, the keymap appearing earlier
  266. in the list takes precedence.")
  267.  
  268. (make-face 'modeline-mousable-minor-mode
  269.        "Face for mousable minor-mode strings in the modeline.")
  270. (set-face-parent 'modeline-mousable-minor-mode 'modeline-mousable)
  271. (when (featurep 'x)
  272.   (set-face-foreground 'modeline-mousable-minor-mode
  273.                '(((color x) . "green4")
  274.              ((color x) . "forestgreen")) 'global))
  275.  
  276. (defvar modeline-mousable-minor-mode-extent (make-extent nil nil)
  277.   ;; alliteration at its finest.
  278.   "Extent managing the mousable minor mode modeline strings.")
  279. (set-extent-face modeline-mousable-minor-mode-extent
  280.          'modeline-mousable-minor-mode)
  281.  
  282. ;; This replaces the idiom
  283. ;;
  284. ;; (or (assq 'isearch-mode minor-mode-alist)
  285. ;;     (setq minor-mode-alist
  286. ;;           (purecopy
  287. ;;            (append minor-mode-alist
  288. ;;                    '((isearch-mode isearch-mode))))))
  289.  
  290. (defvar place)
  291. (defun add-minor-mode (toggle name &optional keymap after toggle-fun)
  292.   "Add a minor mode to `minor-mode-alist' and `minor-mode-map-alist'.
  293.  
  294. TOGGLE is a symbol whose value as a variable specifies whether the
  295. minor mode is active.
  296.  
  297.  If TOGGLE has the `:menu-tag' property set to a string, that string
  298.  will be used as the label on the `modeline-minor-mode-menu' instead
  299.  of TOGGLE's symbol-name.
  300.  
  301.  TOGGLE may have an `:included' property, which determines whether a
  302.  menu button will be shown for this minor mode in the
  303.  `modeline-minor-mode-menu'.  This should be either a boolean
  304.  variable, or an expression evaluating to t or nil.  \(See the
  305.  documentation of `current-menubar' for more information.)
  306.  
  307.  It may have an `:active' property also, as documented in
  308.  `current-menubar'.
  309.  
  310. NAME is the name that should appear in the modeline.  It should either
  311. be a string beginning with a space, or a symbol with a similar string
  312. as its value.
  313.  
  314. KEYMAP is a keymap to make active when the minor mode is active.
  315.  
  316. AFTER is the toggling symbol used for another minor mode.  If AFTER is
  317. non-nil, then it is used to position the new mode in the minor-mode
  318. alists.
  319.  
  320. TOGGLE-FUN specifies an interactive function that is called to toggle
  321. the mode on and off; this affects what happens when button2 is pressed
  322. on the mode, and when button3 is pressed somewhere in the list of
  323. modes.  If TOGGLE-FUN is nil and TOGGLE names an interactive function,
  324. TOGGLE is used as the toggle function.
  325.  
  326. Example: (put 'view-minor-mode :menu-tag \"View (minor)\")
  327.          (put 'view-minor-mode :included '(buffer-file-name))
  328.          (add-minor-mode 'view-minor-mode \" View\" view-mode-map)"
  329.   (let (el place
  330.     (add-elt #'(lambda (elt sym)
  331.              (cond ((null after) ; add to front
  332.                 (set sym (cons elt (symbol-value sym))))
  333.                ((and (not (eq after t))
  334.                  (setq place (memq (assq after
  335.                              (symbol-value sym))
  336.                            (symbol-value sym))))
  337.                 (setq elt (cons elt (cdr place)))
  338.                 (setcdr place elt))
  339.                (t
  340.                 (set sym (append (symbol-value sym) (list elt))))
  341.                )
  342.              (symbol-value sym)))
  343.     toggle-keymap)
  344.     (if toggle-fun
  345.     (if (not (commandp toggle-fun))
  346.         (error "not an interactive function: %S" toggle-fun))
  347.       (if (commandp toggle)
  348.       (setq toggle-fun toggle)))
  349.     (if (and toggle-fun name)
  350.     (progn
  351.       (setq toggle-keymap (make-sparse-keymap
  352.                    (intern (concat "modeline-minor-"
  353.                            (symbol-name toggle)
  354.                            "-map"))))
  355.       (define-key toggle-keymap 'button2
  356.         ;; defeat the DUMB-ASS byte-compiler, which tries to
  357.         ;; expand the macro at compile time and fucks up.
  358.         (eval '(make-modeline-command-wrapper toggle-fun)))
  359.       (put toggle 'modeline-toggle-function toggle-fun)))
  360.     (and name
  361.      (let ((hacked-name
  362.         (if toggle-keymap
  363.             (cons (let ((extent (make-extent nil nil)))
  364.                 (set-extent-keymap extent toggle-keymap)
  365.                 (set-extent-property
  366.                  extent 'help-echo
  367.                  (concat "button2 turns off "
  368.                      (if (symbolp toggle-fun)
  369.                      (symbol-name toggle-fun)
  370.                        (symbol-name toggle))))
  371.                 extent)
  372.               (cons
  373.                modeline-mousable-minor-mode-extent
  374.                name))
  375.           name)))
  376.        (if (setq el (assq toggle minor-mode-alist))
  377.            (setcdr el (list hacked-name))
  378.          (funcall add-elt 
  379.               (list toggle hacked-name)
  380.               'minor-mode-alist))))
  381.     (and keymap
  382.      (if (setq el (assq toggle minor-mode-map-alist))
  383.          (setcdr el keymap)
  384.        (funcall add-elt
  385.             (cons toggle keymap)
  386.             'minor-mode-map-alist)))
  387.     ))
  388.  
  389. ;; gettext anyone?
  390. (put 'abbrev-mode :menu-tag "Abbreviation Expansion")
  391. (add-minor-mode 'abbrev-mode " Abbrev")
  392. ;; only when visiting a file...
  393. (add-minor-mode 'overwrite-mode 'overwrite-mode)
  394. (put 'auto-fill-function :menu-tag "Auto Fill")
  395. (add-minor-mode 'auto-fill-function " Fill" nil nil 'auto-fill-mode)
  396.  
  397. ;; what's the meaning of `####' vs `FIXME' or ...?
  398. ;; not really a minor mode...  and it doesn't work right anyway.
  399. ;;(put 'defining-kbd-macro :menu-tag "Defining kbd macro")
  400. ;;(add-minor-mode 'defining-kbd-macro " Def") FIXME
  401.  
  402. (defun modeline-minor-mode-menu (event)
  403.   "The menu that pops up when you press `button3' inside the
  404. parentheses on the modeline."
  405.   (interactive "e")
  406.   (save-excursion
  407.     (set-buffer (event-buffer event))
  408.     (popup-menu-and-execute-in-window
  409.      (cons "Minor Mode Toggles"
  410.        (apply 'nconc
  411.           (mapcar
  412.            #'(lambda (x)
  413.                (let* ((toggle-sym (car x))
  414.                   (menu-tag (get toggle-sym :menu-tag nil))
  415.                   (toggle-fun
  416.                    (or (get toggle-sym
  417.                     'modeline-toggle-function)
  418.                    (and (fboundp toggle-sym)
  419.                     (commandp toggle-sym)
  420.                     toggle-sym))))
  421.              (if (not toggle-fun) nil
  422.                (list (vector
  423.                   (or (and (stringp menu-tag)
  424.                        menu-tag)
  425.                       (setq menu-tag (capitalize
  426.                               (replace-in-string
  427.                                (replace-in-string
  428.                             (replace-in-string (if (symbolp toggle-fun)
  429.                                            (symbol-name toggle-fun)
  430.                                          (symbol-name toggle-sym))
  431.                                        "-" " ")
  432.                             "minor" " (minor)")
  433.                                " mode" ""))))
  434.                   toggle-fun
  435.                   :active (get toggle-sym :active t)
  436.                   :included (get toggle-sym :included t)
  437.                   :style 'toggle
  438.                   :selected (and (boundp toggle-sym)
  439.                          toggle-sym))))))
  440.            minor-mode-alist)))
  441.      event)))
  442.  
  443. (defvar modeline-minor-mode-map (make-sparse-keymap 'modeline-minor-mode-map)
  444.   "Keymap consulted for mouse-clicks on the minor-mode modeline list.")
  445. (define-key modeline-minor-mode-map 'button3 'modeline-minor-mode-menu)
  446.  
  447. (defvar modeline-minor-mode-extent (make-extent nil nil)
  448.   "Extent covering the minor mode modeline strings.")
  449. (set-extent-face modeline-minor-mode-extent 'modeline-mousable)
  450. (set-extent-keymap modeline-minor-mode-extent modeline-minor-mode-map)
  451.  
  452.  
  453. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  454. ;;;                              Other                                  ;;;
  455. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  456.  
  457. (defun modeline-buffers-menu (event)
  458.   (interactive "e")
  459.   (popup-menu-and-execute-in-window
  460.    '("Buffers Popup Menu"
  461.      :filter buffers-menu-filter
  462.      ["List All Buffers" list-buffers t]
  463.      "--"
  464.      )
  465.    event))
  466.  
  467. (defvar modeline-buffer-id-left-map
  468.   (make-sparse-keymap 'modeline-buffer-id-left-map)
  469. "Keymap consulted for mouse-clicks on the left half of the buffer-id string.")
  470.  
  471. (defvar modeline-buffer-id-right-map
  472.   (make-sparse-keymap 'modeline-buffer-id-right-map)
  473. "Keymap consulted for mouse-clicks on the right half of the buffer-id string.")
  474.  
  475. (define-key modeline-buffer-id-left-map 'button2 'mouse-unbury-buffer)
  476. (define-key modeline-buffer-id-right-map 'button2 'mouse-bury-buffer)
  477. (define-key modeline-buffer-id-left-map 'button3 'modeline-buffers-menu)
  478. (define-key modeline-buffer-id-right-map 'button3 'modeline-buffers-menu)
  479.  
  480. (make-face 'modeline-buffer-id
  481.        "Face for the buffer ID string in the modeline.")
  482. (set-face-parent 'modeline-buffer-id 'modeline)
  483. (when (featurep 'x)
  484.   (set-face-foreground 'modeline-buffer-id "blue4" 'global '(color x)))
  485. (when (featurep 'x)
  486.   (set-face-font 'modeline-buffer-id [bold-italic] nil '(mono x))
  487.   (set-face-font 'modeline-buffer-id [bold-italic] nil '(grayscale x)))
  488. (when (featurep 'tty)
  489.   (set-face-font 'modeline-buffer-id [bold-italic] nil 'tty))
  490.  
  491. (defvar modeline-buffer-id-extent (make-extent nil nil)
  492.   "Extent covering the whole of the buffer-id string.")
  493. (set-extent-face modeline-buffer-id-extent 'modeline-buffer-id)
  494.   
  495. (defvar modeline-buffer-id-left-extent (make-extent nil nil)
  496. "Extent covering the left half of the buffer-id string.")
  497. (set-extent-keymap modeline-buffer-id-left-extent
  498.            modeline-buffer-id-left-map)
  499. (set-extent-property modeline-buffer-id-left-extent 'help-echo
  500.              "button2 cycles to the previous buffer")
  501.  
  502. (defvar modeline-buffer-id-right-extent (make-extent nil nil)
  503. "Extent covering the right half of the buffer-id string.")
  504. (set-extent-keymap modeline-buffer-id-right-extent
  505.            modeline-buffer-id-right-map)
  506. (set-extent-property modeline-buffer-id-right-extent 'help-echo
  507.              "button2 cycles to the next buffer")
  508.  
  509. (defconst modeline-buffer-identification
  510.   (list (cons modeline-buffer-id-left-extent (purecopy "XEmacs%N:"))
  511.                     ; this used to be "XEmacs:"
  512.     (cons modeline-buffer-id-right-extent (purecopy " %17b")))
  513.   "Modeline control for identifying the buffer being displayed.
  514. Its default value is \"XEmacs: %17b\" (NOT!).  Major modes that edit things
  515. other than ordinary files may change this (e.g. Info, Dired,...)")
  516. (make-variable-buffer-local 'modeline-buffer-identification)
  517.  
  518. (defconst modeline-process nil
  519.   "Modeline control for displaying info on process status.
  520. Normally nil in most modes, since there is no process to display.")
  521. (make-variable-buffer-local 'modeline-process)
  522.  
  523. (defvar modeline-modified-map (make-sparse-keymap 'modeline-modified-map)
  524.   "Keymap consulted for mouse-clicks on the modeline-modified string.")
  525. (define-key modeline-modified-map 'button2
  526.   (make-modeline-command-wrapper 'modeline-toggle-read-only))
  527.  
  528. (defvar modeline-modified-extent (make-extent nil nil)
  529.   "Extent covering the modeline-modified string.")
  530. (set-extent-face modeline-modified-extent 'modeline-mousable)
  531. (set-extent-keymap modeline-modified-extent modeline-modified-map)
  532. (set-extent-property modeline-modified-extent 'help-echo
  533.              "button2 toggles the buffer's read-only status")
  534.  
  535. (defconst modeline-modified (purecopy '("--%1*%1+-"))
  536.   "Modeline control for displaying whether current buffer is modified.")
  537. (make-variable-buffer-local 'modeline-modified)
  538.  
  539. (defvar modeline-narrowed-map (make-sparse-keymap 'modeline-narrowed-map)
  540.   "Keymap consulted for mouse-clicks on the modeline-narrowed string.")
  541. (define-key modeline-narrowed-map 'button2
  542.   (make-modeline-command-wrapper 'widen))
  543.  
  544. (defvar modeline-narrowed-extent (make-extent nil nil)
  545.   "Extent covering the modeline-narrowed string.")
  546. (set-extent-face modeline-narrowed-extent 'modeline-mousable)
  547. (set-extent-keymap modeline-narrowed-extent modeline-narrowed-map)
  548. (set-extent-property modeline-narrowed-extent 'help-echo
  549.              "button2 widens the buffer")
  550.  
  551. (setq-default
  552.  modeline-format
  553.  (list
  554.   (purecopy "")
  555.   (cons modeline-modified-extent 'modeline-modified)
  556.   (cons modeline-buffer-id-extent 'modeline-buffer-identification)
  557.   (purecopy "   ")
  558.   'global-mode-string
  559.   (purecopy "   %[(")
  560.   (cons modeline-minor-mode-extent (list "" 'mode-name 'minor-mode-alist))
  561.   (cons modeline-narrowed-extent "%n")
  562.   'modeline-process
  563.   (purecopy ")%]----")
  564.   (purecopy '(line-number-mode "L%l--"))
  565.   (purecopy '(column-number-mode "C%c--"))
  566.   (purecopy '(-3 . "%p"))
  567.   (purecopy "-%-")))
  568.  
  569. ;;; Added for XEmacs 20.3.  Provide wrapper for vc since it may not always be
  570. ;;; present, and its symbols are not visible this early in the dump if it
  571. ;;; is.
  572.  
  573. (defun modeline-toggle-read-only ()
  574.   "Change whether this buffer is visiting its file read-only.
  575. With arg, set read-only iff arg is positive.
  576. This function is designed to be called when the read-only indicator on the
  577. modeline is clicked.  It will call `vc-toggle-read-only' if available,
  578. otherwise it will call the usual `toggle-read-only'."
  579.   (interactive)
  580.   (if (fboundp 'vc-toggle-read-only)
  581.       (vc-toggle-read-only)
  582.     (toggle-read-only)))
  583.  
  584. ;;; modeline.el ends here
  585.